perm filename MOVJ.F4[NEW,LCS] blob sn#148541 filedate 1975-03-04 generic text, type T, neo UTF8
00100		SUBROUTINE MOVJ(ROV,RZRO,RRT,RSTFAC,RN,PWDS,ITEM,I,ML,M)
00110	C  M=4 NORMALLY -- BUT MORE IN 'JUST'
00200		DIMENSION RN(1),PWDS(1),R(2,200),IR(2,200),RSTFAC(1)
00300		EQUIVALENCE (IR,R)
00400		DATA RI/4.5/,RSP/.5/
00500	
00510		IF(ML.EQ.1)GO TO 16
00600		IF(ML)GO TO 19
00800		RJSZ=RI
02705		RCNT=0
02710		ML=1
02720		ROV=RRT
02730		PRCNT=1.
02800		ASK=-1
03200	19	IF(RCNT.GT.9)GO TO 101
03400		RJSZ=RJSZ-.1
03410		RP=PRCNT
03500		RCNT=RCNT+1
03600	C  TEMPORARY COUNTER
03800		CALL TYPX(RCNT)
03900	
03950		KN=-3
04000	CC	DO 11 KN=-3,4
04050	C  HERE BEGINS THE BIG LOOP
04100	111	RSPC=0
04200		R8=KN
04300		N=0
04310	
04400		DO 2 K=1,ITEM
04500		L=PWDS(K)
04600		IF(RTLINE(L))GO TO 2
04700		RA=RN(L+1)
04800		RB=RN(L+3)
04850		IF(RB.LT.RZRO)GO TO 2
04900		IF(RN(L+2).EQ.R8)GO TO 77
05000		IF(RA.NE.4)GO TO 2
05200	C  SKIPS HOMED NOTES (IN CHORDS)
05300	77	IF(RA.EQ.1)GO TO 10
05400	27	IF(RA.LE.4)GO TO 177
05425		IF(RA.LT.17)GO TO 2
05450	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
05500	177	IF(RA.NE.4)GO TO 10
05550		IF(RN(L).GT.2)GO TO 2
05600	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
05700	10	N=N+1
05800		R(1,N)=RB
05900		IR(2,N)=L
06000		IF(N.EQ.200)GO TO 28
06100	C  ONLY TREATS 200 ITEMS AT A TIME.
06200	2	CONTINUE
06210	
06300		IF(N.EQ.0)GO TO 11
06400	28	DO 23 K=1,N
06500	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
06600	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
06700		GO TO 11
06750	101	ML=5
06775		RETURN
06800	24	RSTJ2=RSTFAC(KN)*PRCNT
07000		CALL SORT2(R,N)
07100	
07200	C  JUMP IF LAST IS A BAR LINE.
07300		K=0
07310		JLDGR=0
07400	     	JX=0
07500	22	K=K+1
07600	122	L=IR(2,K)
07700		RA=RN(L+1)
07800		RB=0
07900		RX=RN(L+5)
07950	C  RX=PARAM 5
07975		RX6=RN(L+6)
08000		RY=1
08100		RW=AMOD(RN(L+4),100.)
08200		IF(RA.GT.1)GO TO 4
08300		RZ=RN(L+7)
08325		IF(LDGR.NE.JLDGR)JLDGR=0
08350		LDGR=0
08400		JY=K
08500		DO 32 JJ=JY+1,N+1
08550		K=JJ
08600	32	IF(R(1,JJ)-R(1,JJ-1).GT.RSP)GO TO 35
09000	C  FOUND HOW MANY MEMBERS TO CHORD.
09400	35	RB=0
09450		K=K-1
09500		RQ=0
09600		RD=0
09700	125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
09800		DO 37 JJ=JY,K-1
09850		IF(RD.NE.0)GO TO 38
09875	C FINDS ONLY HIGH OR! LOW LED. LINE.
09887		JR=IR(2,JJ)
09900		RW=AMOD(RN(JR+4),100.)
10000		IF(RW.GT.11)GO TO 277
10025		IF(RW.GE.2)GO TO 38
10050	277	LDGR=-1
10100		IF(RW.GT.11)LDGR=1
10150		IF(JLDGR.EQ.LDGR)GO TO 36
10187		JLDGR=LDGR
10200	C LDGR IS FOR LEDGER LINES.
10225		GO TO 38
10260	36	RD=1.5
10270		RQ=RD
10300	38	IF(RB.GT.2)GO TO 222
10400	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
10500		RZZ=RN(JR+7)
10600		RE=RN(JR+5)
10700	CC	IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
10800	CC	1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
10805		IF(RB.GE.2)GO TO 477
10810		IF(RZZ.GE.10)GO TO 377
10820		IF(RE.GE.20)GO TO 477
10830		IF(AMOD(RZZ,10.).EQ.0)GO TO 477
10890	377	RB=1.5+EXTEN(RZZ)
10900	C  SPACE FOR DOT OR TAIL(IF STEM UP)
11000	477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
11100	C  FOR CHORD TONES ON RIGHT OF STEM UP.
11200	C  LOOKS THROUGH ALL NOTES OF A CHORD.
11300	222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
11400	C  JUMP IF NO ACCIS.
11500	425	RD=2*RY+EXTEN(RE)
11600		IF(RQ.GT.RD)RD=RQ
11700		RQ=RD
11800	C  FUNCT. EXTEN=AMOD(X,1.)*10.
11900	37 	CONTINUE
12000		IF(RY.NE.1)RB=RB-.5*RJSZ
12100	C  MINI NOTES NEED LESS SPACE
12600	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
12700		GO TO 17
12800	4	IF(RA.NE.3)GO TO 29
12900		RB=3
13000		IF(RX.GT.100)RB=1.5
13100	C  CHECK ON SIZE NEEDED FOR CLEFS
13200	29	IF(RA.NE.4)GO TO 26
13300		RB=-RJSZ/2
13400		RD=.9
13500		GO TO 25
13600	26	IF(RA.NE.18)GO TO 30
13700		IF(RX6.GT.9)GO TO 31
13705		IF(RX.GT.9)GO TO 31
13710	C  CHECKS FOR 2-DIGIT METERS
13800		RB=-1
13900		RD=1
14000		GO TO 25
14100	31	RB=2
14200		RD=3
14300		GO TO 25
14400	30	IF(RA.NE.17)GO TO 17
14455		RB=2*(ABS(RX)-1)-2
14460	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
14475		RD=2
14487		GO TO 25
14700	17	RC=(RB+RJSZ)*RSTJ2
14800	C  RJSZ=DEFAULT SIZE
14900		JX=JX+1
15000		R(2,JX)=RC
15100		R(1,JX)=R(1,K)
15200	3	IF(K.LT.N)GO TO 22
15300		RA=R(1,1)
15400		RB=R(2,1)
15500	
15600		DO 13 KX=2,JX
15700		RE=R(1,KX)
15800	C  POS. BEFORE SHIFTING
15900		IF(ABS(RE-RA).GT..5)GO TO 14
16000		IF(R(2,KX).GT.RB)GO TO 16
16100	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
16200		GO TO 13
16400	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
16600	14	RD=RA+RB-RE
16700		IF(RD.LE.0)GO TO 16
16800	C  THERE'S ENOUGH ROOM
17000		R4=RE+RSPC-.001
17100		R5=1000
17200		R8=RD
17300		R9=0
17400		RSPC=RSPC+RD
17500	C  RSPC SAVES TOTAL SPACE ADDED
17600	C  GO EXPAND IT
17700		IF(R(2,KX).NE.0)RETURN
17800	16	RB=R(2,KX)
17900	13	RA=RE
18000	CC11	CONTINUE
18010	11	KN=KN+1
18020		IF(KN.LE.M)GO TO 111
18030	C  M=4 NORMALLY -- BUT FOR 'JUST' IT IS BIGGER.
18040	
18100	110	IF(ROV.LE.RRT+.01)GO TO 18
18110		IF(RJSZ.GT.4)RJSZ=4
18120		PRCNT=(ROV-RZRO)/(RRT-RZRO)
18160	CC	RP=RJSZ/(RJSZ-.1)
18180		IF(PRCNT.NE.RP)GO TO 19
18190	C  GO BACK AND EXPAND SOME MORE
18240	66	ML=2
18265		RETURN
18290	18	ML=3
18590		END